home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turnbull China Bikeride
/
Turnbull China Bikeride - Disc 2.iso
/
BARNET
/
COMPILER
/
SATHER
/
!Sather
/
Library
/
Base
/
sa
/
misc
< prev
next >
Wrap
Text File
|
1996-04-17
|
3KB
|
83 lines
---------------------------> Sather 1.1 source file <--------------------------
-- Copyright (C) International Computer Science Institute, 1994. COPYRIGHT --
-- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
-- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in --
-- the file "Doc/License" of the Sather distribution. The license is also --
-- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA. --
--------> Please email comments to "sather-bugs@icsi.berkeley.edu". <----------
-------------------------------------------------------------------
abstract class $OB is
-- Just a stub. Everything subtypes from $OB, but this may not
-- be explicitly indicated in the compiler/browser type graph
end; -- type $OB
-------------------------------------------------------------------
class EXT_OB is
-- External objects.
end; -- class EXT_OB
-------------------------------------------------------------------
class CAST{T} is
-- Narrow down from $OB to type T. A useful substitute for the
-- one line typecase statement.
-- Usage:
-- a: $OB := 3;
-- b: INT := CAST{INT}::from(a);
--
create: SAME is return new end;
-- Used to get the class name (won't work with void?)
from(o: $OB): T is
-- Cast from o:$OB "o" to be of type T.
-- Raise the exception CAST_EXC if "o" is not of type T
--
-- Usage:
-- a: $OB := 3;
-- b: INT := CAST{INT}::from(a);
typecase o
when T then return o
else raise #CAST_EXC(o,#SAME); end;
end;
end;
-------------------------------------------------------------------
class CAST_EXC < $STR is
-- Exception that is raised when a CAST{T}::from call fails
readonly attr ob: $OB;
readonly attr caster: $OB; -- Mainly so that we can find out the
-- class name of the cast for error reporting.
create(ob: $OB,caster: $OB): SAME is
res ::= new;
res.ob := ob;
res.caster := caster;
return res;
end;
str: STR is
caster_tp::= SYS::tp(caster);
caster_name::= SYS::str_for_tp(caster_tp);
res ::= "Typecasing using:"+caster_name+" ";
if void(ob) then res := res+" attempted to typecase a void object";
else
ob_tp ::= SYS::tp(ob);
ob_classname ::= SYS::str_for_tp(ob_tp);
res := res + " tried an invalid typecase from:"+ob_classname;
end;
return res;
end;
end;
-------------------------------------------------------------------
partial class ID is
-- ID is meant to be included by types that wish to provide object
-- equality as their natural, immutable
-- identity relation
is_eq(arg:$OB):BOOL is return SYS::ob_eq(self,arg) end;
-- is_lt and hash fail for value types
is_lt(arg:$OB):BOOL is return SYS::id(self) < SYS::id(arg) end;
hash:INT is return SYS::id(self).hash end;
end;
-------------------------------------------------------------------+